home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Best of MacTutor - S…e Code for Volumes 1 to 5
/
The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin
/
Source Code
/
#18 (Mar 87)
/
Printer MPW sources
/
PrintTest.p
< prev
next >
Wrap
Text File
|
1986-11-30
|
30KB
|
983 lines
(* @(#) PrintTest.p 11/30/86
{Sources}PrDrvr:PrintTest.p
Examine and display TPrint record values
Written by Joel West, Western Software Technology
MPW Pascal source
Begun with an underlying skeleton, using part of an example from
Apple User Education
File: Example code for a text editor
by Cary Clark, Macintosh Technical Support
Version 1.1 May 13, 1985
Portions copyright © 1986 Joel West, Western Software Technology
*)
PROGRAM PrintTest;
{$R-} {Turn off range checking.}
{$D+} {Debugging symbols.}
{ A document in this program (built using TextEdit) is used to
display the contents of a modified TPrint record, and for no
other purpose.
There are Job and Style dialogs for modifying the record, and
for actually printing out the document.
}
USES
MemTypes,
QuickDraw,
OSIntf,
ToolIntf,
PackIntf,
MacPrint,
StringFormat; { own print formatting routines }
TYPE
WordPtr = ^INTEGER;
MyWindMode = (NullMode, OpenMode, DAMode);
WindowData = RECORD { Can only hold one 32-bit value in wRefCon }
theTE: TEHandle; { for TextEdit record }
theTHP: THPrint; { the TPrint we are analyzing }
END;
WindowDataPtr = ^WindowData;
WindowDataHandle = ^WindowDataPtr;
CONST
{ Change these to suit your taste }
myStdFont = monaco;
myStdSize = 9;
myHdgFont = systemFont; { aka Chicago }
myHdgSize = 12;
{ menus }
appleMenu = 1;
fileMenu = 2;
newItem = 1;
closeItem = 2;
stlItem = 4;
jobItem = 5;
setupItem = 7;
printItem = 8;
quitItem = 10;
lastFileItem = 10;
editMenu = 3;
lastMenu = 3; {Number of menus}
{ Resources }
ALRT_about = 256; { About… message }
ALRT_printerr = 257; { report printing error }
DLOG_printing = 258; { printing status dialog }
STR_id = 0;
STR_pagehead= 256; { page heading }
STR_prepare = 300; { messages for printing status }
STR_printing= 301;
STR_spooling= 302;
STR_of = 303;
STR_prspool = 304;
STRN_scan = 256; { enumeration literals }
STRN_feed = 257;
STRN_wdev = 258;
STRN_job = 259;
STRN_bool = 260;
WIND_main = 256;
{Constant declared for field windowKind}
myDocument = 8;
{ Character }
Return = $0D;
VAR
{The first six variables are changed as windows are activated}
myWindow: WindowPtr;
myPeek: WindowPeek;
hTE: TEHandle; {The active text edit handle}
printHdl: THPrint; {for actual printing}
myMenus: ARRAY [1..lastMenu] OF MenuHandle;
dragRect: Rect;
theChar: CHAR; {Keyboard input goes here}
doneFlag: BOOLEAN;
printFlag: BOOLEAN; {The user selected 'Print…' from the File menu}
currWMode: MyWindMode; { sets menu options }
myEvent: EventRecord; {Shared by all routines}
watchHdl: CursHandle; {The wait cursor}
wdh: WindowDataHandle; { temporary }
ph: THPrint; { temporary for analyzed TPrint record }
spare: Ptr; {a preallocated area to be used by the next window}
linebuff: Str255;
PROCEDURE MainEventLoop;
FORWARD;
{============================TPrint formatting Segment========================}
{$S DumpTPrint }
{---------------------------------Add a line to document-----------------------}
PROCEDURE PrintLine;
VAR
p: Ptr;
c: SignedByte;
BEGIN {this adds the line to end of the display}
p := @linebuff;
TEInsert(Pointer(ORD4(p)+1), Length(linebuff), hTE);
c := Return;
TEInsert(@c, 1, hTE); { add CR }
WITH hTE^^ DO { Check to see if we're beyond bottom of page }
IF (lineHeight*nLines) > (viewRect.bottom - viewRect.top) THEN
TEScroll (0, -hTE^^.lineHeight, hTE); { scroll up one line }
linebuff := '';
END; {PrintLine}
{-------------------------------Formatting utilities---------------------------}
PROCEDURE PrintTab;
VAR
col, nexttab: INTEGER;
BEGIN { add spaces to next multiple of 8 }
col := Length(linebuff);
nexttab := col - BAND(col,7) + 8 ;
linebuff[0] := CHR(nexttab);
WHILE col < nexttab DO
BEGIN
col := col+1;
linebuff[col] := ' ';
END;
END;
PROCEDURE PrintHex(n: LONGINT; w: INTEGER);
BEGIN
SWriteHex(linebuff, n, w); { actual width }
END;
PROCEDURE PrintInt(n: LONGINT);
BEGIN
SWriteInt(linebuff, n, 0); { minimum width }
END;
PROCEDURE PrintString(s: Str255);
BEGIN
SWriteString(linebuff, s);
END;
PROCEDURE PrintStrNum(s: Str255; n: LONGINT);
BEGIN { format a string and integer }
PrintTab;
SWriteString(linebuff, s);
SWriteInt(linebuff, n, 0); { minimum width }
END;
PROCEDURE PrintStrHex(s: Str255; n: LONGINT; w: INTEGER);
BEGIN { format a string and hex }
PrintTab;
SWriteString(linebuff, s);
SWriteHex(linebuff, n, w);
END;
{ --------------------------- Format enumeration ----------------------------- }
PROCEDURE DumpEnum(msg: Str255; val, resid: INTEGER);
VAR
s: Str255;
rh: Handle;
limitp: WordPtr;
BEGIN
PrintTab;
PrintString(msg);
rh := GetResource('STR#', resid);
IF (rh <> NIL) THEN { if we screwed up, don't try to format }
BEGIN
limitp := WordPtr(rh^); { number of strings }
IF (val >= 0) AND (val < limitp^) THEN
BEGIN { in range defined }
GetIndString(s, resid, val+1);
PrintString(s);
EXIT(DumpEnum);
END
END;
PrintInt(val); { no string, show the integer }
END;
{ -------------------------------- Format Rect ------------------------------- }
PROCEDURE DumpRect(msg: Str255; r: Rect);
BEGIN
PrintString(msg);
PrintString(': {');
PrintInt(r.top);
PrintString(', ');
PrintInt(r.left);
PrintString(', ');
PrintInt(r.bottom);
PrintString(', ');
PrintInt(r.right);
PrintString('}');
PrintLine;
END;
{ -------------------------------- Format TPrInfo ---------------------------- }
PROCEDURE DumpPrInfo(msg: Str255; prinf: TPrInfo);
BEGIN
PrintString(msg);
PrintStrNum('iDev: ', prinf.iDev);
PrintStrNum('iVRes: ', prinf.iVRes);
PrintStrNum('iHRes: ', prinf.iHRes);
PrintLine;
DumpRect('rPage', prinf.rPage);
END;
{ -------------------------------- Format TPrXInfo --------------------------- }
PROCEDURE DumpPrXInfo(msg: Str255; prxi: TPrXInfo);
BEGIN
PrintString(msg);
PrintStrNum('iRowBytes: ', prxi.iRowBytes);
PrintStrNum('iBandH: ', prxi.iBandV);
PrintStrNum('iBandV: ', prxi.iBandH);
PrintLine;
PrintStrNum('iDevBytes: ', prxi.iDevBytes);
PrintStrNum('iBands: ', prxi.iBands);
PrintLine;
PrintStrNum('bPatScale: ', prxi.bPatScale);
PrintStrNum('bUlThick: ', prxi.bUlThick);
PrintStrNum('bUlOffset: ', prxi.bUlOffset);
PrintStrNum('bUlShadow: ', prxi.bUlShadow);
PrintLine;
DumpEnum('scan: ', ORD(prxi.scan), STRN_scan);
PrintStrNum('bXInfoX: ', prxi.bXInfoX);
PrintLine;
END;
{ -------------------------------- Format TPrStl ----------------------------- }
PROCEDURE DumpPrStl(msg: Str255; ps: TPrStl);
BEGIN
PrintString(msg);
PrintStrHex('wDev: $', ps.wDev, 4);
DumpEnum('(', BSR(ps.wDev, 8), STRN_wdev); { device code }
PrintString(')');
PrintLine;
PrintStrNum('iPageV: ', ps.iPageV);
PrintStrNum('iPageH: ', ps.iPageH);
PrintStrNum('bPort: ', ps.bPort);
DumpEnum('feed: ', ORD(ps.feed), STRN_feed);
PrintLine;
END;
{ --------------------------------- Format TPrJob ---------------------------- }
PROCEDURE DumpPrJob(msg: Str255; pj: TPrJob);
BEGIN
PrintString(msg);
PrintStrNum('iFstPage: ', pj.iFstPage);
PrintStrNum('iLstPage: ', pj.iLstPage);
PrintStrNum('iCopies: ', pj.iCopies);
DumpEnum('bJDocLoop: ', ORD(pj.bJDocLoop), STRN_job);
PrintLine;
DumpEnum('fFromUsr: ', ORD(pj.fFromUsr), STRN_bool);
PrintStrHex('pIdleProc: ', ORD4(pj.pIdleProc), 8);
PrintStrHex('pFileName ', ORD4(pj.pFileName), 8);
PrintLine;
PrintStrNum('iFileVol: ', pj.iFileVol);
PrintStrNum('pFileVers: ', pj.bFileVers);
PrintStrNum('bJobX: ', pj.bJobX);
PrintLine;
END;
{ --------------------------- Format printX Array ---------------------------- }
PROCEDURE DumpPrintX(msg: Str255; tpp: TPPrint);
VAR
i, max: INTEGER;
BEGIN { Outputs non-zero values, if any; ignore trailing run of zero}
max := 0;
FOR i := 1 TO 19 DO
IF (tpp^.printX[i] <> 0) THEN
max := i; { ignore trailing zeroes }
IF (max > 0) THEN
BEGIN
PrintString(msg);
FOR i := 1 TO max DO
BEGIN
PrintStrNum('[', i);
PrintString(']: ');
PrintHex(tpp^.printX[i], 4);
IF (((i MOD 4) = 0) OR (i = max)) THEN
PrintLine; { every 4th or last one }
END
END
END;
{ ------------------------------- Format TPrint ------------------------------ }
PROCEDURE DumpPrint(msg: Str255; hand: THPrint);
VAR
tpp: TPPrint;
i: INTEGER;
BEGIN
HLock(Handle(hand));
tpp := hand^; { pointer to a TPrint }
PrintLine;
PrintString(msg);
PrintLine;
FOR i := 1 TO Length(msg) DO
PrintString('-');
PrintLine;
PrintString('iPrVersion: ');
PrintInt(tpp^.iPrVersion);
PrintLine;
DumpPrInfo('prInfo', tpp^.prInfo);
DumpRect('rPaper', tpp^.rPaper);
DumpPrStl('prStl', tpp^.prStl);
DumpPrInfo('prInfoPT', tpp^.prInfoPT);
DumpPrXInfo('prXInfo', tpp^.prXInfo);
DumpPrJob('prJob', tpp^.prJob);
DumpPrintX('printX', tpp);
PrintString(
'------------------------------------------------------------------------------'
);
PrintLine;
HUnLock(Handle(hand));
END; {DumpPrint}
{=================================Windows Segment=============================}
{$S Windows }
{-------------------------Update menus based on windows------------------------}
PROCEDURE CheckWindowMode;
VAR
newmode: MyWindMode;
fileset: SET OF 1..lastFileItem;
item: INTEGER;
BEGIN { This routine enable/disables menu items based on window mode }
myPeek := WindowPeek(FrontWindow);
IF myPeek = NIL THEN
newmode := NullMode { no windows open }
ELSE
IF myPeek^.windowKind = MyDocument THEN
newmode := OpenMode { document window on top }
ELSE
newmode := DAMode; { D.A. on top }
IF newmode <> currWMode THEN { Must change menus }
BEGIN
CASE newmode OF
NullMode: { No windows open }
fileset := [newItem,quitItem];
OpenMode: { One window open and on top }
fileset := [closeItem,stlItem,jobItem,setupItem,printItem,quitItem];
DAMode: { DA on top }
fileset := [closeItem,quitItem];
END; {CASE}
FOR item := 1 TO lastFileItem DO
IF item IN fileset THEN
EnableItem(myMenus[fileMenu], item)
ELSE
DisableItem(myMenus[fileMenu], item);
IF newmode = DAMode THEN
EnableItem(myMenus[editMenu], 0)
ELSE
DisableItem(myMenus[editMenu], 0);
DrawMenuBar; { menu dimming must be updated }
currWMode := newmode;
END; {IF}
END; {CheckWindowMode}
{---------------------------Close the front window-----------------------------}
PROCEDURE CloseAWindow;
BEGIN
{ This routine closes an application (or DA) window, either after
• clicking go-away box
• selecting "Close" in File menu }
myPeek := WindowPeek(FrontWindow);
IF myPeek^.windowKind = myDocument THEN
BEGIN
wdh := WindowDataHandle(GetWRefCon(WindowPtr(myPeek)));
ph := wdh^^.theTHP;
DisposHandle(Handle(ph));
TEDispose(hTE);
hTE := NIL;
DisposHandle(Handle(wdh));
DisposeWindow(myWindow);
END
ELSE { Must be a DA }
CloseDeskAcc(myPeek^.windowKind)
END; {CloseAWindow}
{---------------------------Deactivate before dialog---------------------------}
PROCEDURE DialogueDeactivate;
VAR
temprect: Rect;
BEGIN
{Deactivate the top window if we're about to put up a dialog}
SetCursor(arrow);
IF hTE <> NIL THEN {for documents, only}
TEDeactivate(hTE);
END; {DialogueDeactivate}
{-------------------------Draw a document window-------------------------------}
PROCEDURE DrawWindow;
VAR
tempport: GrafPtr;
temprect, rectToErase: Rect;
temppeek: WindowPeek;
whichwindow: WindowPtr;
temphTE: TEHandle;
BEGIN
{Draws the content region of the given window, after erasing whatever
was there before. }
whichwindow := WindowPtr(myEvent.message);
BeginUpdate(whichwindow);
GetPort(tempport);
SetPort(whichwindow);
temppeek := WindowPeek(whichwindow);
IF temppeek^.windowKind = myDocument THEN
BEGIN
temprect := whichwindow^.Portrect;
wdh := WindowDataHandle(GetWRefCon(whichwindow));
temphTE := wdh^^.theTE;
SetRect(temprect, - 32767, - 32767, 32767, 32767);
ClipRect(temprect);
{this only erases the window past the end of text, if any}
WITH temphTE^^ DO
IF nLines < (viewRect.bottom - viewRect.top +
lineHeight) DIV lineHeight THEN
BEGIN
rectToErase := viewRect;
rectToErase.top := (nLines ) * lineHeight;
EraseRect(rectToErase)
END;
TEUpdate(whichwindow^.visRgn^^.rgnBBox, temphTE)
END;
SetPort(tempport);
EndUpdate(whichwindow)
END; {DrawWindow}
{----------------------------Handle (de)activate events------------------------}
PROCEDURE MyActivate;
BEGIN {This activates or deactivates the current selection}
myWindow := WindowPtr(myEvent.message);
myPeek := WindowPeek(myWindow);
IF myPeek^.windowKind = myDocument THEN
BEGIN { document window }
wdh := WindowDataHandle(GetWRefCon(myWindow));
hTE := wdh^^.theTE;
IF ODD(myEvent.modifiers) THEN { BAND(myEvent.modifiers,activeFlag)>0 }
TEActivate(hTE) {this window is now top most}
ELSE {this window is no longer top most}
BEGIN
TEDeactivate(hTE);
hTE := NIL {a TextEdit window is no longer on top}
END;
END;
END; {MyActivate}
{------------------------------Create a new document window--------------------}
PROCEDURE OpenAWindow;
VAR
r: Rect;
BEGIN {A window is created here}
IF spare <> NIL THEN
BEGIN
DisposPtr(spare);
spare := NIL
END;
myWindow := GetNewWindow(WIND_main, NIL, Pointer( - 1));
wdh := WindowDataHandle(NewHandle(SIZEOF(WindowData)));
SetWRefCon(myWindow, ORD(wdh)); { stash pointer to TEHandle in window }
SetPort(myWindow);
myPeek := WindowPeek(myWindow);
TextFont(myStdFont);
TextSize(myStdSize);
DrawChar(' ');
SetFontLock(TRUE);
myPeek^.windowKind := myDocument; {identifies the type of window}
r := myWindow^.Portrect;
InsetRect(r, 8, 4);
hTE := TENew(r, r);
wdh^^.theTE := hTE;
hTE^^.destRect := hTE^^.viewRect;
hTE^^.crOnly := -1; { no automatic CR }
PrOpen;
ph := THPrint(NewHandle(SIZEOF(TPrint)));
PrintDefault(ph);
wdh^^.theTHP := ph;
DumpPrint('After PrintDefault(…)', ph);
PrClose;
END; {OpenAWindow}
{================================Printing Segment=============================}
{$S Printing }
{----------------------------Print out a document window-----------------------}
PROCEDURE DoPrinting;
CONST
bottommargin = 20;{ margins (in pixels) for document, inset from rPage }
leftmargin = 30;
rightmargin = 10;
topmargin = 36;
VAR
txth: Handle;
printTE: TEHandle;
MyPPort: TPPrPort;
dlogptr: DialogPtr;
txtptr: Ptr;
linesperpage, height, firstoffset, lastoffset, leftpos, toppos, fstpos,
lineno, lastline, linecount, pageno, firstpage, lastpage, numpages,
copyno, numpasses, dummyitem, errno: INTEGER;
pagerect: Rect;
currstr, laststr, heading: Str255;
strh0, strh1, hdgstrh: StringHandle;
status: TPrStatus;
info: FontInfo;
lastonpage: ARRAY [0..99] OF INTEGER; { last line # on each page }
BEGIN
{ This section images each page, using QuickDraw via TextEdit
A few special cases:
1. For spooled output (IW only), must image and then print
2. For IW draft mode, must send multiple copies ourself
This has been completely rewritten from skeleton code, for a number
of key reasons:
1. A location is calculated for each line and then DrawText is
used to draw the line. This also requires setting the font
directly in the printing GrafPort. The skeleton used TextBox
for each page; TextBox uses an EraseRect which, according to
Technical Note #72, is very slow on the LaserWriter.
2. We use crOnly, so only actual returns are used for line
breaks. Thus, we don't need a new TECalText for the
printing destRect, but instead use the TextEdit lineStarts
established for display purposes.
3. This routine figures out what the actual pages selected are,
and then prints only those pages. (The values of prJob.iFstPage
and iLstPage need to be fudged to do this.)
4. Put a heading on each page, showing page number.
5. Put up an Alert if a printing error is encountered. Not strictly
necessary, since the most commonly found "errors" are user-
specified aborts that should be ignored.
}
printFlag := FALSE; { so we don't print again }
DialogueDeactivate;
IF PrJobDialog(printHdl) THEN
BEGIN
SetCursor(watchHdl^^);
{ Put up progress dialog }
strh0 := GetString(STR_prepare);
ParamText(strh0^^,'','','');
dlogptr := GetNewDialog(DLOG_printing, NIL, Pointer(-1));
DrawDialog(dlogptr);
printTE := hTE;
{ Calculate number of pages, and line numbers for each page }
WITH printTE^^, printHdl^^.PrInfo DO
BEGIN
txth := hText;
height := lineHeight;
linecount := nLines;
linesperpage := (rPage.bottom - rPage.top - bottommargin - topmargin)
DIV height;
pagerect := rPage; { top margin allows for heading }
pagerect.left := pagerect.left + leftmargin;
pagerect.right := pagerect.right - rightmargin;
pagerect.bottom := pagerect.top + topmargin +
(linesperpage * height);
fstpos := pagerect.top + topmargin + fontAscent;
{ base line of first line of text in document }
END; {WITH}
lastonpage[0] := 0;
pageno := 1;
lineno := 0;
WHILE lineno < linecount DO { until we run out of pages }
BEGIN
lineno := lineno + linesperpage;
IF lineno < linecount THEN { all but last page }
lastonpage[pageno] := lineno-1 { last line on this page }
ELSE { last page }
lastonpage[pageno] := linecount-1;{ lines numbered 0..n }
pageno := pageno + 1;
END; {WHILE}
numpages := pageno - 1;
{ We could skip page calculations, but then we would image all pages and
Print Manager would print only those selected. Obviously this is
inefficient for large documents. Instead, fool Print Manager into
thinking enough pages are selected and then do actual printing starting
at the selected page. This MUST be done before PrOpenDoc. }
WITH printHdl^^.PrJob DO
BEGIN
firstpage := iFstPage; { page numbers requested }
IF firstpage < 1 THEN
firstpage := 1;
lastpage := iLstPage;
IF lastpage > numpages THEN
lastpage := numpages; { limit to available pages }
numpages := lastpage - firstpage + 1; { actual length }
iFstPage := 1; { fool print manager }
iLstPage := numpages; { reset by next PrJobDialog }
{ Manual handling of multiple copies for draft mode only
ImageWriter spooling handles this directly; the LaserWriter PrJobDialog
always sets iCopies := 1 and hides the actual number of copies from us
Also set up appropriate progress message }
IF bJDocLoop = bSpoolLoop THEN
BEGIN
numpasses := 1; { only one pass through }
strh0 := GetString(STR_spooling);{ "Now spooling " }
END
ELSE
BEGIN
numpasses := iCopies; { draft mode, multiple passes }
strh0 := GetString(STR_printing);{ "Now printing " }
END;
END; {WITH}
strh1 := GetString(STR_of); { " of " }
hdgstrh := GetString(STR_pagehead); { "Page " }
{ Now do actual printing (or imaging, for spool mode
Get a drawing port: TPrint should be frozen by now
Go through it once for every copy (if necessary) and once per page
Show dialog progress in terms of pages to be printed }
MyPPort := PrOpenDoc(printHdl, NIL, NIL);
NumToString(numpages, laststr); { actual # of pages to print }
FOR copyno := 1 TO numpasses DO
BEGIN
MoveHHi(txth);
HLock(txth);
txtptr := txth^;
FOR pageno := firstpage TO lastpage DO
BEGIN { Image each page; this does printing for draft mode }
IF PrError <> noErr THEN
LEAVE; { quit }
NumToString(pageno-firstpage+1, currstr); {relative page #}
ParamText(strh0^^, currstr, strh1^^, laststr);
DrawDialog(dlogptr); { update the status }
PrOpenPage(MyPPort, NIL); { changes GrafPort for us }
{ First put a heading on the page. Since MoveTo location for drawing text
is the base line, need ascent to position heading within pagerect }
TextFont(myHdgFont);
TextSize(myHdgSize);
GetFontInfo(info); { need ascent height }
NumToString(pageno, heading); { absolute page number }
heading := Concat(hdgstrh^^, heading); { "Page 1" }
WITH pagerect DO
BEGIN
leftpos := left + { center }
((right-left - StringWidth(heading)) DIV 2 );
MoveTo(leftpos, top+info.ascent); { base line }
DrawString(heading); { print page heading }
{ Now print actual document for this page }
leftpos := left; { left margin for text }
toppos := fstpos; { base line for 1st line }
END;
TextFont(printTE^^.txFont); { set for display }
TextSize(printTE^^.txSize);
lineno := lastonpage[pageno-1];{ line of TERec }
firstoffset := printTE^^.lineStarts[lineno];
lastline := lastonpage[pageno];
{ Draw each line in TERec, excluding CR at end of line }
WHILE lineno <= lastline DO
BEGIN
MoveTo(leftpos, toppos);
lineno := lineno + 1;
IF lineno >= linecount THEN
lastoffset := printTE^^.teLength { very last line }
ELSE
lastoffset := printTE^^.lineStarts[lineno]-1;
DrawText(txtptr, firstoffset, lastoffset-firstoffset);
toppos := toppos + height;
firstoffset := lastoffset+1;
END; {each line}
PrClosePage(MyPPort); { done with this page }
END; {each page}
HUnLock(txth);
END; {each copy}
PrCloseDoc(MyPPort);
{ If spooled, the file is now imaged and now need to print it }
IF (printHdl^^.prJob.BJDocLoop = BSpoolLoop)
AND (PrError = noErr) THEN
BEGIN
strh0 := GetString(STR_prspool); { "Now printing spool file" }
ParamText(strh0^^, '', '', '');
DrawDialog(dlogptr);
PrPicFile(printHdl, NIL, NIL, NIL, status);
END;
{ Drop the advice dialog }
DisposDialog(dlogptr);
SetCursor(arrow);
errno := PrError;
IF (errno <> noErr) AND { indicate a printing error, unless… }
(errno <> iPrAbort) AND { user hit command-period }
(errno <> iIOAbort) THEN { user cancel on "not responding" alert }
BEGIN
NumToString(errno, currstr); { error number }
ParamText(currstr, '', '', ''); { should be more user-friendly }
dummyitem := StopAlert(ALRT_printerr, NIL);
END;
END {IF PrJobDialog}
ELSE { Cancel in PrJobDlog }
PrSetError(iPrAbort);
END; {DoPrinting}
{===============================Initialization Segment========================}
{$S Initial }
{---------------------------------Initialize everything------------------------}
PROCEDURE SetUp;
VAR
counter: INTEGER;
BEGIN
{ Come here with InitGraf and InitWindows already done to avoid fragmentation
Put this code in a segment that can be immediately unloaded}
InitFonts; { the last 5 of the standard 7 }
FlushEvents(everyEvent, 0);
TEInit;
InitDialogs(NIL);
InitMenus; {initialize Menu Manager }
watchHdl := GetCursor(WatchCursor);
HNoPurge(Handle(watchHdl));
printHdl := THPrint(NewHandle(SizeOf(TPrint)));
PrOpen;
PrintDefault(printHdl); { the one used for actual printing }
PrClose;
{ Build some menus }
FOR counter := 1 TO lastMenu DO
myMenus[counter] := GetMenu(counter);
AddResMenu(myMenus[1], 'DRVR'); {desk accessories }
FOR counter := 1 TO lastMenu DO
InsertMenu(myMenus[counter], 0);
DrawMenuBar;
dragRect := screenbits.bounds;
dragRect.top := dragRect.top + 20; {leave room for menu bar}
InsetRect(dragRect, 4, 4); {leave some of dragged rectangle on screen}
doneFlag := FALSE;
printFlag := FALSE;
currWMode := nullMode;
OpenAWindow; { put up the window for displaying output }
END; {SetUp}
{==============================Menu commands Segment==========================}
{$S Command}
{----------------------------------Alert for About…----------------------------}
PROCEDURE AboutThisProgram;
VAR
itemhit: INTEGER;
hand: StringHandle;
BEGIN
DialogueDeactivate;
hand := GetString(STR_id); { identity string }
ParamText(hand^^, '', '', '');
itemhit := NoteAlert(ALRT_about, NIL);
END; {AboutThisProgram}
{---------------------------------Handle menu command--------------------------}
PROCEDURE DoCommand (commandkey: BOOLEAN);
VAR
daname: Str255;
refnum, theMenu, theItem: INTEGER;
menuResult: LONGINT;
daedit: BOOLEAN;
BEGIN
IF commandkey THEN
menuResult := MenuKey(theChar)
ELSE
menuResult := MenuSelect(myEvent.where);
theMenu := HiWrd(menuResult); { HiWord() }
theItem := LoWrd(menuResult); { LoWord() }
CASE theMenu OF
appleMenu: {enough memory to allow desk accessory to open}
BEGIN
IF theItem = 1 THEN
AboutThisProgram
ELSE
BEGIN
GetItem(myMenus[appleMenu],theItem,daname);
DisposPtr(spare);
spare := NIL;
refNum := OpenDeskAcc(daname)
END
END;
fileMenu:
BEGIN
CASE theItem OF
newItem: {New }
OpenAWindow;
closeItem: {Close }
CloseAWindow;
stlItem: {PrStlDialog… }
BEGIN
PrOpen;
DialogueDeactivate;
IF PrStlDialog (wdh^^.theTHP) THEN
DumpPrint('After PrintStlDialog(…)', wdh^^.theTHP);
PrClose
END;
jobItem: {PrJobDialog… }
BEGIN { just modifying TPrint, not actually printing }
PrOpen;
DialogueDeactivate;
IF PrJobDialog (wdh^^.theTHP) THEN
DumpPrint('After PrJobDialog(…)', wdh^^.theTHP);
PrClose
END;
setupItem: {Page Setup… }
BEGIN
PrOpen;
DialogueDeactivate;
IF PrStlDialog (PrintHdl)
THEN ;
PrClose
END;
printItem: {Print }
printFlag := TRUE;
{ Call actual printing logic from main event loop to unload maximal segments }
quitItem: {Quit }
doneFlag := TRUE;
END {CASE theItem}
END; {fileMenu}
editMenu:
daedit := SystemEdit(theitem-1);
END; {CASE}
HiLiteMenu(0);
END; {DoCommand}
{=========================Main Segment (never unloaded)=======================}
{$S Main}
{-------------------------------The main event loop----------------------------}
PROCEDURE MainEventLoop;
VAR
tempwindow: WindowPtr; {window referenced by GetNextEvent}
BEGIN
REPEAT
SystemTask;
IF printFlag THEN
BEGIN
PrOpen;
DoPrinting;
PrClose
END;
IF GetNextEvent(everyEvent, myEvent) THEN
BEGIN
CASE myEvent.what OF
mouseDown:
BEGIN
CASE FindWindow(myEvent.where, tempwindow) OF
inMenuBar:
DoCommand(FALSE);
inSysWindow:
SystemClick(myEvent, tempwindow);
inDrag:
DragWindow(tempwindow, myEvent.where, dragRect);
inContent:
SysBeep(1);
inGoAway:
IF TrackGoAway(tempwindow, myEvent.where) THEN
CloseAWindow;
END {of code case }
END; {of mouseDown }
keyDown, autoKey:
BEGIN { replace BAND() with BitAnd() if necessary }
theChar := CHR(BAND(myEvent.message, charCodeMask));
IF BAND(myEvent.modifiers, CmdKey) <> 0 THEN
DoCommand(TRUE) { do menu equivalent }
ELSE
SysBeep(1); { no typing allowed! }
END; {of keyDown}
activateEvt:
MyActivate;
updateEvt:
DrawWindow;
END; {of event case }
CheckWindowMode;
END
ELSE
IF (myEvent.what = nullEvent) AND doneFlag AND
(FrontWindow <> NIL) THEN
CloseAWindow;
{ We like to leave lots of memory available, so unload everything as a precaution }
UnloadSeg(@DoCommand); {segment DoCommand}
UnloadSeg(@PrintLine); {segment DumpTPrint}
UnloadSeg(@OpenAWindow); {segment Windows}
UnloadSeg(@DoPrinting); {segment Printing}
IF spare = NIL THEN {Create a space for the next window to be opened.}
spare := NewPtr(SizeOf(dialogRecord));
{Since all segments are unloaded, this will not fragment the free memory space.}
UNTIL doneFlag AND (FrontWindow = NIL);
END;
{-----------------------------Memory initialization----------------------------}
PROCEDURE SetUpMemory; { Initialize in main segment }
BEGIN
MaxApplZone;
MoreMasters;
MoreMasters;
MoreMasters;
MoreMasters;
END;
{-------------------------------Main program-----------------------------------}
BEGIN {main program }
SetUpMemory;
InitGraf(@thePort);
InitWindows; { allocates a nonrelocatable block}
spare := NewPtr(SizeOf(dialogRecord));
{ reserve space for one window, since this is non-relocatable }
SetUp; { do normal setup }
UnloadSeg(@SetUp); { done with it forever }
InitCursor;
MainEventLoop;
SetCursor(watchHdl^^);
END. {main}